home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE09 / INTERNAL / FORMAT.PAS
Encoding:
Pascal/Delphi Source File  |  1996-04-08  |  17.9 KB  |  516 lines
  1. { Note: This code is given for illustrative purposes only.  A final
  2.   version of the code will be provided on next month's cover disk.
  3.  
  4.                             Dave Jewell
  5. }
  6.  
  7. unit Format;
  8.  
  9. interface
  10.  
  11. uses
  12.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  13.   Forms, Dialogs;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     procedure FormClick(Sender: TObject);
  18.   private
  19.     { Private declarations }
  20.   public
  21.     { Public declarations }
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.DFM}
  30.  
  31. {=============================================}
  32.  
  33. const
  34.     { Format capacities }
  35.     DF_360K     =       0;
  36.     DF_12M      =       1;
  37.     DF_720K     =       2;
  38.     DF_14M      =       3;
  39.     DF_28M      =       4;
  40.     DF_Unknown  =       5;
  41.  
  42. const
  43.     fAbort: Bool = False;   { <---- interface part }
  44.  
  45. type
  46.     PBPB = ^BPB;
  47.     BPB = record                 { offsets assume boot sector }
  48.     bsBytesPerSec: Integer;            { 00 bytes per sector }
  49.         bsSecPerClust: Byte;            { 02 sectors per cluster }
  50.         bsResSectors: Integer;            { 03 number of reserved sectors }
  51.         bsFATs: Byte;                { 05 number of file allocation tables }
  52.         bsRootDirEnts: Integer;            { 06 number of root-directory entries }
  53.     bsSectors: Integer;                    { 08 total number of sectors }
  54.         bsMedia: Byte;                    { 0A media descriptor }
  55.         bsFATsecs: Integer;                    { 0B number of sectors per FAT }
  56.         bsSecPerTrack: Integer;                { 0D sectors per track }
  57.         bsHeads: Integer;                    { 0F number of heads }
  58.     bsHidden1: Integer;            { 11 hidden sectors (lo) }
  59.     end;
  60.  
  61.     PDeviceParams = ^DeviceParams;
  62.     DeviceParams = record
  63.     SpecFunc: Byte;                     { 00 }
  64.     DevType: Byte;                { 01 }
  65.     DevAttrs: Integer;            { 02 }
  66.     Tracks: Integer;            { 04 }
  67.     MediaType: Byte;            { 06 }
  68.     bpb: BPB;                    { 07 }
  69.     bsHidden2: Integer;                { 1A }
  70.     HugeSectors: LongInt;                { 1C }
  71.         Reserved: array [0..5] of Char;         { 20 !!! UNDOCUMENTED !!!}
  72.         { Start of TRACKLAYOUT information }
  73.         SectorsPerTrack: Integer;               { 26 }
  74.         TrackLayout: array [0..35] of LongInt;  { 28 }
  75.     end;
  76.  
  77.     PDiskType = ^DiskType;
  78.     DiskType = record
  79.         spc: Byte;              { sectors per cluster }
  80.         rde: Integer;           { number of root-dir entries }
  81.         sec: Integer;           { total number of sectors }
  82.         med: Byte;              { media descriptor }
  83.         spf: Integer;           { number of sectors per FAT }
  84.         spt: Integer;           { sectors per track }
  85.         cls: Integer;           { cluster count }
  86.     end;
  87.  
  88.     RWBlock = record
  89.        rwSpecFunc: Byte;        { special functions (must be zero) }
  90.        rwHead: Integer;         { head to read/write }
  91.        rwCylinder: Integer;     { cylinder to read/write }
  92.        rwFirstSector: Integer;  { first sector to read/write }
  93.        rwSectors: Integer;      { number of sectors to read/write }
  94.        rwBuffer: Pointer;       { address of buffer for read/write data }
  95.     end;
  96.  
  97. const
  98.     { This array maps a logical drive type to a list of     }
  99.     { parameters for that drive.  Assumptions:              }
  100.     { Bytes per sector = 512  Reserved sectors = 1          }
  101.     { Number of FATS = 2      Heads = 2                     }
  102.     { Hidden sectors = 0      Tracks = 80 except 40 for 1st }
  103.  
  104.     DiskTypes: array [0..4] of DiskType = (
  105.  
  106.     (spc:2; rde:112; sec: 720; med:$FD; spf:2; spt: 9; cls:354),   { 360 K }
  107.     (spc:1; rde:224; sec:2400; med:$F9; spf:7; spt:15; cls:2371),  { 1.2 M }
  108.     (spc:2; rde:112; sec:1440; med:$F9; spf:3; spt: 9; cls:713),   { 720 K }
  109.     (spc:1; rde:224; sec:2880; med:$F0; spf:9; spt:18; cls:2847),  { 1.4 M }
  110.     (spc:2; rde:240; sec:5760; med:$F0; spf:9; spt:36; cls:2863)); { 2.8 M }
  111.  
  112.     
  113. const FloppyBoot: array [0..511] of Byte = (
  114.     $EB, $3C, $90, $4D, $53, $44, $4F, $53,
  115.     $35, $2E, $30, $00, $02, $01, $01, $00,
  116.         $02, $E0, $00, $40, $0B, $F0, $09, $00,
  117.         $12, $00, $02, $00, $00, $00, $00, $00,
  118.         $00, $00, $00, $00, $00, $00, $29, $E9,
  119.         $17, $47, $37, $4E, $4F, $20, $4E, $41,
  120.         $4D, $45, $20, $20, $20, $20, $46, $41, 
  121.         $54, $31, $32, $20, $20, $20, $FA, $33,
  122.     $C0, $8E, $D0, $BC, $00, $7C, $16, $07, 
  123.     $BB, $78, $00, $36, $C5, $37, $1E, $56,
  124.     $16, $53, $BF, $3E, $7C, $B9, $0B, $00, 
  125.     $FC, $F3, $A4, $06, $1F, $C6, $45, $FE,
  126.     $0F, $8B, $0E, $18, $7C, $88, $4D, $F9, 
  127.     $89, $47, $02, $C7, $07, $3E, $7C, $FB,
  128.     $CD, $13, $72, $79, $33, $C0, $39, $06, 
  129.     $13, $7C, $74, $08, $8B, $0E, $13, $7C,
  130.     $89, $0E, $20, $7C, $A0, $10, $7C, $F7, 
  131.     $26, $16, $7C, $03, $06, $1C, $7C, $13,
  132.     $16, $1E, $7C, $03, $06, $0E, $7C, $83, 
  133.     $D2, $00, $A3, $50, $7C, $89, $16, $52,
  134.     $7C, $A3, $49, $7C, $89, $16, $4B, $7C, 
  135.     $B8, $20, $00, $F7, $26, $11, $7C, $8B,
  136.     $1E, $0B, $7C, $03, $C3, $48, $F7, $F3, 
  137.     $01, $06, $49, $7C, $83, $16, $4B, $7C,
  138.     $00, $BB, $00, $05, $8B, $16, $52, $7C, 
  139.     $A1, $50, $7C, $E8, $92, $00, $72, $1D,
  140.     $B0, $01, $E8, $AC, $00, $72, $16, $8B, 
  141.     $FB, $B9, $0B, $00, $BE, $E6, $7D, $F3,
  142.     $A6, $75, $0A, $8D, $7F, $20, $B9, $0B,
  143.     $00, $F3, $A6, $74, $18, $BE, $9E, $7D,
  144.     $E8, $5F, $00, $33, $C0, $CD, $16, $5E, 
  145.     $1F, $8F, $04, $8F, $44, $02, $CD, $19,
  146.     $58, $58, $58, $EB, $E8, $8B, $47, $1A, 
  147.     $48, $48, $8A, $1E, $0D, $7C, $32, $FF,
  148.     $F7, $E3, $03, $06, $49, $7C, $13, $16, 
  149.     $4B, $7C, $BB, $00, $07, $B9, $03, $00,
  150.     $50, $52, $51, $E8, $3A, $00, $72, $D8, 
  151.     $B0, $01, $E8, $54, $00, $59, $5A, $58,
  152.     $72, $BB, $05, $01, $00, $83, $D2, $00,
  153.     $03, $1E, $0B, $7C, $E2, $E2, $8A, $2E,
  154.     $15, $7C, $8A, $16, $24, $7C, $8B, $1E, 
  155.     $49, $7C, $A1, $4B, $7C, $EA, $00, $00,
  156.     $70, $00, $AC, $0A, $C0, $74, $29, $B4, 
  157.     $0E, $BB, $07, $00, $CD, $10, $EB, $F2,
  158.     $3B, $16, $18, $7C, $73, $19, $F7, $36, 
  159.     $18, $7C, $FE, $C2, $88, $16, $4F, $7C,
  160.     $33, $D2, $F7, $36, $1A, $7C, $88, $16, 
  161.     $25, $7C, $A3, $4D, $7C, $F8, $C3, $F9,
  162.     $C3, $B4, $02, $8B, $16, $4D, $7C, $B1, 
  163.     $06, $D2, $E6, $0A, $36, $4F, $7C, $8B,
  164.     $CA, $86, $E9, $8A, $16, $24, $7C, $8A, 
  165.     $36, $25, $7C, $CD, $13, $C3, $0D, $0A,
  166.     $4E, $6F, $6E, $2D, $53, $79, $73, $74, 
  167.     $65, $6D, $20, $64, $69, $73, $6B, $20,
  168.     $6F, $72, $20, $64, $69, $73, $6B, $20,
  169.     $65, $72, $72, $6F, $72, $0D, $0A, $52,
  170.     $65, $70, $6C, $61, $63, $65, $20, $61,
  171.     $6E, $64, $20, $70, $72, $65, $73, $73,
  172.     $20, $61, $6E, $79, $20, $6B, $65, $79,
  173.     $20, $77, $68, $65, $6E, $20, $72, $65,
  174.     $61, $64, $79, $0D, $0A, $00, $49, $4F, 
  175.     $20, $20, $20, $20, $20, $20, $53, $59,
  176.     $53, $4D, $53, $44, $4F, $53, $20, $20, 
  177.     $20, $53, $59, $53, $00, $00, $55, $AA );
  178.  
  179. const
  180.     DiskParams: PChar = Nil;                { pointer to disk params }
  181.  
  182. var
  183.     dp: DeviceParams;
  184.     TargetBPB: BPB;
  185.     OldDeviceParams: DeviceParams;          { stash for drive params }
  186.     FATMask: array [0..359] of Byte;        { pointer to FAT mask  }
  187.     OldDiskParams: array [0..10] of Char;   { stash for old values }
  188.  
  189. function SenseMediaType (Drive: Byte; fDefault: Bool; pdp: PDeviceParams): Integer;
  190. var
  191.     count: Integer;
  192. begin
  193.     FillChar (pdp^, sizeof (DeviceParams), 0);
  194.     if not fDefault then pdp^.SpecFunc := 1;
  195.  
  196.     asm
  197.         mov     ax,440Dh        { Specify generic IOCTL call     }
  198.         mov     bl,Drive        { BL = wanted drive number       }
  199.         mov     cx,$0860        { Request device parameters      }
  200.         push    ds              { save DS register               }
  201.         lds     dx,pdp          { ds:dx points to param block    }
  202.         call    Dos3Call        { make the call                  }
  203.         pop     ds              { restore DS register            }
  204.         jc      @@1             { if error, return code in AX    }
  205.         xor     ax,ax           { else clear AX register         }
  206. @@1:
  207.         mov     count,ax          { stash result in 'err'          }
  208.     end;
  209.  
  210.     if count <> 0 then SenseMediaType := -1 else
  211.         for count := DF_360K to DF_28M do
  212.             if pdp^.bpb.bsSectors = DiskTypes [count].sec then
  213.             begin
  214.                 SenseMediaType := count;
  215.                 Exit;
  216.             end;
  217. end;
  218.  
  219. procedure FormatInit;
  220. begin
  221.     if DiskParams = Nil then
  222.     begin
  223.         { Reset disk system and get INT $1E vector }
  224.         asm
  225.             mov     ah,$0D                      { specify disk reset     }
  226.             call    Dos3Call                    { do it                  }
  227.             mov     ax,$351E                    { specify INT $1E vector }
  228.             call    DOS3Call                    { result in ES:BX regs   }
  229.             mov     word ptr DiskParams,bx      { set up offset part     }
  230.             mov     word ptr DiskParams+2,es    { set up segment part    }
  231.         end;
  232.  
  233.         { Make a copy of existing disk parameters }
  234.         Move (DiskParams^, OldDiskParams, sizeof (OldDiskParams));
  235.     end;
  236.  
  237.     { Clear FAT buffer }
  238.     FillChar (FATMask, sizeof (FatMask), 0);
  239. end;
  240.  
  241. procedure FormatTerminate;
  242. begin
  243.     if DiskParams <> Nil then
  244.     begin
  245.         { Restore old disk parameter values }
  246.         Move (OldDiskParams, DiskParams^, sizeof (OldDiskParams));
  247.         DiskParams := Nil;
  248.     end;
  249. end;
  250.  
  251. function GenSerialNumber: LongInt; assembler;
  252. asm
  253.     mov     ah,$2A              { request system date }
  254.     call    DOS3Call            { result in CX:DX     }
  255.     push    cx                  { push year part      }
  256.     push    dx                  { push month/day      }
  257.     mov     ah,$2C              { request system time }
  258.     call    DOS3Call            { result in CX:DX     }
  259.     pop     ax                  { pop month/day       }
  260.     add     ax,dx               { add to seconds/100  }
  261.     pop     dx                  { pop year part       }
  262.     add     dx,cx               { add hours/minutes   }
  263. end;
  264.  
  265. function WriteAbs (buff: Pointer; Drive, Track, Head: Integer): Integer;
  266. var
  267.     p: Pointer;
  268.     err: Integer;
  269.     rwb: RWBLOCK;
  270. begin
  271.     rwb.rwSpecFunc := 0;                { always zero }
  272.     rwb.rwHead := Head;                 { head to read/write }
  273.     rwb.rwCylinder := Track;            { track to read/write }
  274.     rwb.rwFirstSector := 0;             { first sector to read/write }
  275.     rwb.rwSectors := 1;                 { # sectors to read/write }
  276.     rwb.rwBuffer := buff;               { buffer for data }
  277.  
  278.     p := @rwb;
  279.     err := 0;
  280.  
  281.     asm
  282.         mov  ax,$440D               { specify generic IOCTL call }
  283.         mov  bl,byte ptr Drive      { BL = drive number          }
  284.         mov  cx,$0841               { write track to  disk       }
  285.         push ds                     { save DS on stack           }
  286.         lds  dx,p                   { point to param block       }
  287.         call DOS3Call               { do the business...         }
  288.         pop  ds                     { restore DS register        }
  289.         jnc  @@1                    { branch if no error         }
  290.         xor  bx,bx                  { clear BX register          }
  291.         mov  ah,$59                 { request extended error code}
  292.         call DOS3Call               { result in AX register      }
  293.         mov  err,ax                 { stash it                   }
  294. @@1:
  295.     end;
  296.  
  297.     WriteAbs := err;
  298. end;
  299.  
  300. function WriteBootSector (Drive: Byte; SrcBPB: PBPB): Integer;
  301. const
  302.     BPBSig: array [0..7] of Char = 'FAT16   ';
  303. var
  304.     DestBPB: PBPB;
  305.     i: Integer;
  306.     SerNum: LongInt;
  307.     BootSector: array [0..511] of Byte;
  308. begin
  309.     { Get a copy of the default boot record }
  310.     Move (FloppyBoot, BootSector, sizeof (BootSector));
  311.     { Add the BPB for this specific disk capacity }
  312.     DestBPB := @BootSector [11];
  313.     DestBPB^ := SrcBPB^;
  314.     { Init extended boot stuff }
  315.     for i := $1E to $24 do BootSector [i] := 0;
  316.     SerNum := GenSerialNumber;
  317.     Move (SerNum, BootSector [$27], sizeof (SerNum));
  318.     Move (BPBSig, BootSector [$36], 8);
  319.     WriteBootSector := WriteAbs (@BootSector, Drive, 0, 0);
  320. end;
  321.  
  322. function SetMediaType (Drive, Size: Integer): Integer;
  323. var
  324.     err: Byte;
  325.     p: Pointer;
  326.     sec: Integer;
  327.     dp: DeviceParams;
  328. begin
  329.     { Use default diskparams as starting point }
  330.     dp := OldDeviceParams;
  331.     if Size = -1 then dp.SpecFunc := 4 else
  332.     begin
  333.         { Set up 'dp' according to wanted disk size }
  334.         dp.SpecFunc := 5;
  335.         dp.DevType := Size;
  336.         if Size = 3 then dp.DevType := 7;
  337.         if Size = 4 then dp.DevType := 9;
  338.         if Size = 0 then begin dp.Tracks := 40; dp.MediaType := 1; end;
  339.  
  340.         dp.bpb.bsBytesPerSec := 512;
  341.         dp.bpb.bsSecPerClust := DiskTypes [Size].spc;
  342.         dp.bpb.bsResSectors  := 1;
  343.         dp.bpb.bsFATs        := 2;
  344.         dp.bpb.bsRootDirEnts := DiskTypes [Size].rde;
  345.         dp.bpb.bsSectors     := DiskTypes [Size].sec;
  346.         dp.bpb.bsMedia       := DiskTypes [Size].med;
  347.         dp.bpb.bsFATsecs     := DiskTypes [Size].spf;
  348.         dp.bpb.bsSecPerTrack := DiskTypes [Size].spt;
  349.         dp.bpb.bsHeads       := 2;
  350.         dp.bpb.bsHidden1     := 0;
  351.  
  352.         TargetBPB := dp.bpb;
  353.         dp.bsHidden2 := 0;
  354.         dp.HugeSectors := 0;
  355.         dp.SectorsPerTrack := dp.bpb.bsSecPerTrack;
  356.         for sec := 0 to dp.SectorsPerTrack - 1 do
  357.             dp.TrackLayout [sec] := MakeLong (sec + 1, 512);
  358.     end;
  359.  
  360.     { Now tell DOS this is what we want ! }
  361.     p := @dp;
  362.     err := 0;
  363.  
  364.     asm
  365.         mov  ax,$440D           { specify generic IOCTL call }
  366.         mov  bl,byte ptr Drive  { BL = drive number          }
  367.         mov  cx,$0840           { set device parameters      }
  368.         push ds                 { save DS on stack           }
  369.         lds  dx,p               { get pointer to ParamBlock  }
  370.         call DOS3Call           { do the business...         }
  371.         pop  ds                 { restore DS register        }
  372.         jnc  @@1                { branch if no error         }
  373.         mov  err,ah             { stash error code           }
  374. @@1:
  375.     end;
  376.  
  377.     SetMediaType := err;
  378. end;
  379.  
  380. function FormatTrack (Drive, Track, Head: Byte): Integer;
  381. type
  382.     FVBlock = record
  383.                   SpecFunc: Byte;
  384.                   fvHead: Integer;
  385.                   fvCylinder: Integer;
  386.                   fvTracks: Integer;
  387.               end;
  388. var
  389.     err: Integer;
  390.     p: Pointer;
  391.     fvb: FVBlock;
  392. begin
  393.     fvb.SpecFunc := 0;
  394.     fvb.fvHead := Head;
  395.     fvb.fvCylinder := Track;
  396.  
  397.     p := @fvb;
  398.     err := 0;
  399.  
  400.     asm
  401.         mov  ax,$440D      { specify generic IOCTL call }
  402.         mov  bl,Drive      { BL = drive number          }
  403.         mov  cx,$0842      { format track on drive      }
  404.         push ds            { save DS on stack           }
  405.         lds  dx,p          { point to Format block      }
  406.         call DOS3Call      { format the track...        }
  407.         pop  ds            { restore DS register        }
  408.         jnc  @@1           { branch if no error         }
  409.         xor  bx,bx         { clear BX register          }
  410.         mov  ah,$59        { request extended error code}
  411.         call DOS3Call      { result in AX register      }
  412.         mov  err,ax        { stash it                   }
  413. @@1:
  414.     end;
  415.  
  416.     if not (err in [0, $17, $1B, $1F]) then err := -1;
  417.     FormatTrack := err;
  418. end;
  419.  
  420. function FormatDisk (Drive, Size: Integer): Integer;
  421. label
  422.     Stop;
  423. var
  424.     pDisk: PDiskType;
  425.     TracksLeft, TotTracks, CurTrk, CurHead, CurSector,
  426.     err, Cluster, SysSectors, DefSize, DiskSize, count: Integer;
  427. begin
  428.     { Assume failure and validate drive number }
  429.     FormatDisk := -1;
  430.     fAbort := False;
  431.     if not Drive in [1..2] then Exit;
  432.  
  433.     { Stash current drive setup }
  434.     DefSize := SenseMediaType (Drive, True, @OldDeviceParams);
  435.  
  436.     { If we're quick-formatting, then auto-sense the current media }
  437.     DiskSize := Size;
  438.     if DiskSize = -1 then DiskSize := SenseMediaType (Drive, False, @dp);
  439.  
  440.     { If media not present or other error, then slow-format }
  441.     if DiskSize = -1 then
  442.     begin
  443.         if MessageDlg ('Can''t quick-format this disk.  Format to default capacity?',
  444.             mtConfirmation, [mbYes, mbNo], 0) = mrNo then Exit;
  445.         DiskSize := DefSize;
  446.     end;
  447.  
  448.     { Establish wanted media size with DOS }
  449.     if DiskSize <> DefSize then
  450.        if SetMediaType (Drive, DiskSize) <> 0 then Exit;
  451.  
  452.     { Grab disk params table }
  453.     pDisk := @DiskTypes [DiskSize];
  454.     FormatInit;
  455.  
  456.     { Tweak disk params table for wanted format }
  457.     DiskParams [4] := Chr (pDisk^.spt);
  458.     if pDisk^.spt = 15 then DiskParams [7] := Chr ($54)
  459.     else DiskParams [7] := Chr ($50);
  460.  
  461.     { Now we can format the tracks }
  462.     if DiskSize = 0 then TotTracks := 80 else TotTracks := 160;  { Heads=2! }
  463.     SysSectors := (2 * pDisk^.spf) + (((pDisk^.rde * 32) + 511) div 512) + 1;
  464.     TracksLeft := TotTracks; CurHead := 0; CurTrk := 0;
  465.  
  466.     { Only format tracks if not quick formatting }
  467.     if Size <> -1 then
  468.     begin
  469.         { Main formatting loop }
  470.         while TracksLeft <> 0 do
  471.         begin
  472.             { Let somebody else get a look-in ! }
  473.             Application.ProcessMessages;
  474.             if fAbort then goto Stop;
  475.             if FormatTrack (Drive, CurTrk, CurHead) = -1 then goto Stop;
  476.             CurSector := ((CurTrk * 2) + CurHead) * pDisk^.spt;
  477.             count := CurSector;
  478.             while count < CurSector + pDisk^.spt do
  479.             begin
  480.                 Cluster := ((count - SysSectors) div pDisk^.spc) + 2;
  481.                 FatMask [Cluster shr 3] := FatMask [Cluster shr 3] or (1 shl (Cluster and 7));
  482.                 Inc (count);
  483.             end;
  484.  
  485.             Dec (TracksLeft);
  486.             Inc (CurHead);
  487.             if CurHead >= 2 then
  488.             begin
  489.                 CurHead := 0;
  490.                 Inc (CurTrk);
  491.             end;
  492.         end;
  493.     end;
  494.  
  495.     { Write a new boot sector to the disk }
  496.     WriteBootSector (Drive, @TargetBPB);
  497.     { Let somebody else get a look-in ! }
  498.     Application.ProcessMessages;
  499.     if fAbort then goto Stop;
  500.  
  501.     { @@@@WATCH THIS SPACE@@@@ }
  502.  
  503. Stop:
  504.     SetMediaType (Drive, -1);
  505.     FormatTerminate;
  506. end;
  507.  
  508. procedure TForm1.FormClick(Sender: TObject);
  509. var
  510.     Str: String;
  511. begin
  512.     FormatDisk (1, 3);
  513. end;
  514.  
  515. end.
  516.